C*** 33 PARAMS SEEMS TO BE LIMIT IN THIS VERSION. (30 IN 'SCORE') *****
	SUBROUTINE TRANS(JJJ)
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	DIMENSION NN(100)
C  W(35) FOR PARAMETERS
C  THE 'ROUT' COMMON BLOCK IS 1ST OUTPUT BLOCK IN 'PASS3'.
      COMMON /ROUT/I(200) ,RX(80),JX(80)  /TR/LX(12),K
     1,INSNUM(27),P(30),NPAR(27),JSEM,IPRNT,IPP
     1,SRATE,RNCHN,RMAG,INUM,INS,MM,M,N,JJ,X,Y,IK
     1,ENDX,J  /KNAM/IPLAY,JFLNM  /IFIRST/IFIRST,IDT
	1 /INST/INST(27)
	1 /WDZ/WDZ(14),JWD(12) 
      COMMON /SBFILN/SBFILN /AR/IOP /IGEN/IGEN /JP/JPRNT
      COMMON LL  /P/W(1)  /CONV/ICONV /FQDR/FQDR(28,27),INSN
      INTEGER FQDR
C****************CHECK NEAR HERE FOR NEEDED CHANGES **************
   	INTEGER*4 IDBL,JANP,JBLA,JFLNM,JDBG,
   	1 INST,INAM,JSEMI,ICOLON
      EQUIVALENCE (LESS,LX(9)),(IX,IXJ,JX),(RX2,RX(3)),
     1(P2,P(2)),(RX3,RX(5)),(I3,I(3)),(ISEMI,LX(2))
     1,(IBLA,LX(1)),(IAST,LX(3)),(IINS,INST),(IEQUAL,LX(8))
     1,(IAROW,LX(7)),(W1,W),(W3,W(3)),(W2,W(2))

      DATA LX/' ',';', '*','/','-','+','←','=','<' ,',' ,'(', ')'/,
     1  IDOT/'.'/, IDEV/1/,JPRNT/1/,JFLNM/'TRNS'/,N0/'0'/,N9/'9'/
	1,JBLA/'    '/,JDBG/'#   '/,JPERC/'%   '/,JSEMI/';   '/
C*** THIS VERSION STARTS OUT WITH DEFAULT OUTPUT TO FILE: TRNS.DAT
      DATA RMAG/.0512/,INUM/0/,SRATE/12800./,RNCHN/1./,JQUOT/'"    '/
	1,JEXP/'!   '/,JANP/'&   '/,ICONV/-1/,JCOLON/':   '/
C ICONV=-1 MEANS WRITE A SOUND FILE. (=0 = WRITE A FILE FOR 'SMPLS' PROG.)

	GO TO (555,500) JJJ
555      IF(IFIRST)404,  5,5  
404      IGEN=-1
	KA=1
C KA IS POINTER TO INPUT ARRAY
	IF(INUM.NE.0)GO TO 30
	DO 411 K=1,27 
411	INST(K)=0
CIN	DO 411 K=1,108
CIN411	IINS(K)=0
C ZERO OUT INSTR. NAME ARRAY.
30    IPLAY=0
      ENDX=0
	KK=0
      JSEM=0
      INS=-1
402      IDEV=1
412      WRITE(JTYPE,1)
1	 FORMAT(' INPUT? '$)
100      FORMAT(' >'$)
2      FORMAT(A4)
	READ(JTYPE,2)IDBL
C IDBL WILL HAVE TO BE DOUBLE PREC. ON PDP11 ************
      IF(IDBL.NE.JBLA)GO TO 400
      IDEV=5
      GO TO 5
400      IF(IDBL.NE.JANP)GO TO 602    
	JPRNT=-JPRNT
	GO TO 412
C!*** & IS PRNT-NOPRNT FLIPFLOP
602      IF(IDBL.NE.JQUOT)GO TO 408
C!*** " FOR INSTRUMENT LIST.
      DO 606 K=1,INUM
	JK=INSNUM(K)
	MM=NPAR(JK)-2
606      WRITE(JTYPE,607)INST(K),JK,MM
      GO TO 402
607      FORMAT(1X,A4,'  INS#',I2,'  PARAMS=',I2)      
C!*** PRINTS INST INFO.
408	IF(IDBL.NE.JEXP)GO TO 603
C TRIGGERS ICONV FLIPFLOP
	IF(ICONV.LT.0)GO TO 2408
	ICONV=-1
	WRITE(JTYPE, 3408)
	GO TO 412
2408	ICONV=0
	WRITE(JTYPE, 4408)
	GO TO 412
3408	FORMAT(' OUTPUT=TEST.SND'/)
4408	FORMAT(' OUTPUT=TEST.DAT'/)
603	IF(IDBL.EQ.JPERC)CALL PLAY
C TYPE % TO RE-PLAY SOUND
2326	FORMAT(1X100A1)
410	IF(IDBL.EQ.JCOLON)CALL EXIT
C TYPE ':' TO EXIT AND CLOSE ALL FILES.
C11******************************************???????????????????
	CALL CLOSIT(IDEV)
CCCC	CALL CLOSE(IDEV)
C11******************************************???????????????????
	CALL DISKO(IDEV,IDBL,3)
C                        3=OPEN FORMATTED INPUT FILE.
4      FORMAT(100A1)

5     IF(KA.NE.1)GO TO 521
502      IF(IDEV.NE.5)GO TO 601
C*******************************
      IF(IGEN.NE.2)IGEN=-1
503      WRITE(JTYPE, 100)
C*******************************
601	KA=1
	READ(IDEV,4,END=404)NN
121	DO 421 LEND=100,1,-1
C FIND LAST CHAR. IN LINE
421	IF(NN(LEND).NE.IBLA)GO TO 621
C NOW WE'VE FOUND A BLANK LINE
	IF(IDEV.EQ.1)GO TO 601
	GO TO 402
621	IF(IDEV.EQ.5)GO TO 521 
	IF(JPRNT.LT.0)WRITE(JTYPE, 2326)(NN(IJI),IJI=1,LEND)
521	IF(KK.EQ.0)JA=0
C KK IS FLAG FOR CONTINUATION LINES.
	DO 21 LSEM=KA,LEND
	LS=NN(LSEM)
	IF(LS.NE.LESS)GO TO 21
	KK=0
	GO TO 601
21	IF(LS.EQ.ISEMI)GO TO 821
C SET FLAG TO LOOP BACK TO READ ANOTHER LINE
	KK=-1
	GO TO 721

821	KK=0
C SET KK TO 0 EVERY TIME WE HIT A SEMICOLON
221	IF(LSEM.EQ.1)GO TO 721
	KB=LSEM-1
	IF(NN(KB).NE.IBLA)GO TO 721
C DELETE BLANKS BEFORE A SEMICOLON
	NN(KB)=ISEMI
	NN(LSEM)=IBLA
	IF(LEND.EQ.LSEM)LEND=LEND-1
	LSEM=LSEM-1
	GO TO 221
721	IF(JA.EQ.0)GO TO 921
	JA=JA+1
	I(JA)=IBLA
C INSERT A BLANK IF A CONTINUATION LINE.
921   	KC=IBLA
C LEADING BLANKS AND MULTIPLE BLANKS ARE DELETED.
	DO 321 KB=KA,LSEM
C LSEM IS CHAR COUNT IN I ARRAY NOW (LOCATES THE SEMI COLON)
	K=NN(KB)
	IF(K.NE.IBLA)GO TO 1021
	IF(KC.EQ.IBLA)GO TO 321
C DELETE STRINGS OF BLANKS
1021	JA=JA+1
	I(JA)=K
	KC=K
321	CONTINUE
C CURRENTLY CAN STORE 200 CHARS. IN I ARRAY. (ENOUGH FOR 30 PARAMS?)
	KA=LSEM+1
	IF(KA.GT.LEND)KA=1
	IF(KK.NE.0)GO TO 502
C GO READ MORE IF NO SEMICOLON WAS FOUND.
	IF(I(1).EQ.ISEMI)GO TO 5
C CATCHES DUPLICATE SEMICOLON
1408      DO 407 K=1,80 
407      JX(K)=IBLA
406      MM=0
C INIT VARIOUS THINGS
	DO 4061 J=2,80,2
4061	RX(J)=0
        J=-1      
      IPRNT=0
119      JI=0
9      M=0
	N=JI+1
6      JI=JI+1
	   KCHAR=I(JI)
      DO 7 L=1,12
7      IF(KCHAR.EQ.LX(L))GO TO 8
C JUMP OUT IF PUNCT., SPACE, SEMI., ETC.
      M=M+1
      GO TO 6            
C!**** NO STRING CAN EXCEED 10 CHARS.
8       IF(M.EQ.0)GO TO 140
      IF(M.GT.10)M=10
      MM=MM+1
      IF(MM.LE.40)GO TO 88
      WRITE(JTYPE, 888)(I(JJ),JJ=N,N+9)
      STOP
888      FORMAT(' LINE TOO LONG -- ',10A1)
88      JJ=I(N)
	IF(JJ.GT.N9)GO TO 16  
	IF(JJ.NE.IDOT.AND.JJ.LT.N0)GO TO 16
C**** 8240='0'  8249='9'
C!***** JUMP IF 1ST CHAR. IS A LETTER.
	Y=0
      DOT=10.
      DO 18 JK=N,N+M-1
      KB=I(JK)
      IF(KB.NE.IDOT)GO TO 17
      DOT=.1
      GO TO 18
17    X=NASCI(KB)                 
C!**** CHANGE ASCII INTO NUMBER
      IF(DOT.LT.1)GO TO 19
      Y=Y*DOT+X
      GO TO 18
19      Y=Y+X*DOT
      DOT=DOT/10.
18      CONTINUE
	IF(IGEN.EQ.2)Y=Y*100+1000.
C ABOVE PUTS CONSTANTS IN INS DEFINITIONS. PLUS ONLY. LIMIT??
      RX(MM*2-1)=Y
      RX(MM*2)=-9999.0
      GO TO 140

16	JK=MM*2-1
        CALL MPACK(M,I(N),JX(JK),N)
C N=CURRENT POINTER TO I ARRAY - USED LATER TO LOCATE INST. NAMES.
	IJ=JX(JK)
	IF(IJ.GE.0)GO TO 144
C IF IJ < 0, THEN IT'S A LETTER
	JX(MM*2)=M
C SAVE THE WD CNT OF POTENTIAL INST. NAME.
	GO TO 143
144	IF(IJ.NE.408)GO TO 140
C "WORD" TYPES OUT RESERVED WORD LIST
	WRITE(JTYPE, 244)WDZ,JWD
	WRITE(JTYPE, 245)
	GO TO 503
244	FORMAT(15(1XA4))
245	FORMAT(' %=REPLAY, &=SHOW INPUT, !=SOUND-SIGHT, "=
	1INSTS., :=EXIT, CLOSE FILES')
140      IF(IJ.EQ.400)GO TO 5
C  400='PLAY;' THIS CAN BE THROWN AWAY NOW.
143	IF(KCHAR.EQ.IBLA)GO TO 10
      IF(L.EQ.7)KCHAR=IEQUAL     
141   MM=MM+1
	KI=MM*2-1
	JX(KI)=KCHAR
10      IF(JI.EQ.JA)GO TO 15
C  JA POINTS TO LAST CHAR. TO LOOK AT FOR NOW.
1010	IF(I(JI+1).NE.IBLA)GO TO 11
      JI=JI+1
      GO TO 1010
11	IF(JI.LT.JA)GO TO 9
C NOW WE HAVE ALL ITEMS IN IX ARRAY
	IF(MM.GT.1)GO TO 15
C CATCH 'WORD  ;' AT END OF LINE
	IF(M.EQ.0)GO TO 5
15      MM=MM*2
142      J=-1      
      IF(INS.LT.0)GO TO 305
      IF(INS.EQ.2)GO TO 305
      MM=0
      INS=-1    
C!***** NOW INITIALIZATION COMPLETE
      GO TO 5
50      LL=LL-1
	IF(IGEN)308,309,309
309   IF(IJ.EQ.12)IGEN=-1   
C!*** FOUND 'END'
      IF(IJ.NE.412)GO TO 59
C JUMP IF NOT 'INS' LINE.
  	IF(LL.NE.2)GO TO 59
C IF WDCNT IS 2, DO THE NEXT
  	LL=3
C NOW YOU CAN HAVE 'INS 2;' INSTEAD OF 'INS 0 2;' ETC. (EITHER WAY!)
  	W3=W2
  	W2=0
	GO TO 59
308      W1=1
	IK=W2
      IF(LL.GT.NPAR(IK))GO TO 56
54      IF(LL.LT.3)LL=3
      DO 55 K=LL,NPAR(IK)
55      W(K)=P(K-2)    
C!***** GET INFO ALREADY IN PARAMS
56      DO 57 K=3,LL
57      P(K-2)=W(K)      
C!**** FILL UP P LIST AGAIN
      X=W3            
C!*** EXCHANGE W2 AND W3, ACTION TIME, INST #
      W3=W2
      W2=X
58      LL=NPAR(IK)
      DO 52 K=5,LL
	KI=FQDR(K-4,IK)
	IF(KI)53,52,2352
2352      W(K)=RMAG/W(K)
      GO TO 52
53      W(K)=RMAG*W(K)
52      CONTINUE
      IF(ENDX.LT.W2+P2)ENDX=W2+P2
59       IF(W1.NE.2.)GO TO 592
	IF(LL.EQ.2)GO TO 597
C JUMP IF 'END' OF INS DEF.
	IF(LL.NE.3)GO TO 595
C  JUMP IF NOT AN INST DEF.
	PSV=0
	SV=35
C EXPLAIN USE OF STORAGE PARAMS!!
	INSN=W3
C  INS DEF NUM.
	DO 586 K=1,28
C CLEAR FREQ-DUR FLAGS FOR THIS INST.
586	FQDR(K,INSN)=0
C LIST OF INST NAMES MUST FOLLOW 'INS N;'  !!!ALWAYS!!!
596	READ(IDEV,2,END=587)INAM
	IF(INAM.EQ.JSEMI)GO TO 592
C LIST OF INST NAMES TERMINATES WITH ';'.
	DO 588 K=1,INUM
	IF(INAM.NE.INST(K))GO TO 588
	INST(K)=INAM
	INSNUM(K)=INSN
	GO TO 589
587	PAUSE 'MISSING SEMICOLON'
588	CONTINUE
	INUM=INUM+1
	INST(INUM)=INAM
C LIST OF INST NAMES TERMINATES WITH ';'.
	INSNUM(INUM)=INSN
589	IF(JPRNT.LT.0)WRITE(JTYPE, 244)INAM
	GO TO 596

595	DO 593 K=3,LL
	X=W(K)
	IF(X.LT.0.OR.X.GT.100)GO TO 593
	IF(X.GT.PSV)PSV=X
C CHECK FOR OVERLAPPING PARAM NUMS.
593	CONTINUE
	 IF(W3.NE.102.AND.W3.NE.105.AND.W3.NE.111.AND.W3.NE.104
	1 .AND.W3.NE.115)GO TO 592
C 115=NOS, 102=OSC, 105=ENV, 104=RAI (3 STOR. LOCS), 111=RAH (2 STOR. LOCS)
C NEXT SETS UP STORAGE LOCATIONS FOR OSC, ENV, RAN, AND RAH.
	X=W3
594	LL=LL+1
	W(LL)=SV
	SV=SV-1
C DECREMENT THE HIGH PARAM NUM.
	IF(SV.LT.PSV)PAUSE 'PARAMETER OVERLAP'
CIN	IF(SV.LT.PSV)CALL ERROR(5)
C  IF STORAGE PARAM NUM. OVERLAPS WITH INSTS/'S PARAMS = ERROR
	IF(X.NE.111.AND.X.NE.104)GO TO 592
	IF(X.EQ.111)X=0
	IF(X.EQ.104)X=111
	GO TO 594

597	NPAR(INSN)=PSV
C SAVE THE HIGHEST PARAM NUM.

592	IF(JPRNT.GE.0)GO TO 591
      WRITE(JTYPE, 51)LL,(W(K),K=1,LL)
C ABOVE WRITES ONTO FILE 'D.DAT' *** TEMPORARY FOR DEBUGGING.
591      IDT=2
	RETURN

500      IFIRST=0
      IF(IGEN.EQ.0)IGEN=-1
      IF(W1.NE.6)GO TO 555
      RETURN
C  W1=6 = 'FINISH;'  [W ARRAY IS EQUIV. TO P ARRAY IN MUSIC5]

306      IF(JPRNT.LT.0)WRITE(JTYPE, 1307)(W(K),K=1,LL-1)
	      IF(JPRNT.GT.0)WRITE(JTYPE, 307)(W(K),K=1,LL-1)
      IPRNT=0                  
C!** RESET NO-PRNT FLAG
      INS=-1
	GO TO 5
C!** GO READ ANOTHER LINE
305	CALL MSCAN
	IF(IJ.EQ.401)GO TO 500
C 401=FINISH WAS FOUND.
	IF(IPRNT.LT.0)GO TO 306
	IF(JSEM.EQ.0)GO TO 5
	GO TO 50
51      FORMAT(I3,35F10.3/)
307      FORMAT('+',F8.2,$)
1307      FORMAT(F10.3)
      END

	FUNCTION NASCI(N)
CPDP10	DATA IEX/536870912/,IZERO/'0'/
C THIS BIG NUMBER MUST BE CHANGED ON PDP11***************
CPDP10	NASCI=(N-IZERO)/IEX
C CONVERTS SINGLE ASCII CHARACTER TO INTEGER.
   	NASCI=N-8240
C  THIS FORM FOR PDP11
	END